Filter out Generic Questions

Questions with same text but different Answers

x.questions.id.filterd <- x.questions.id %>% 
  anti_join(
    x.questions.id %>% 
      group_by(File, SubjectID, Question) %>% 
      summarise(cnt = n(), question_number = paste(key, collapse = ",")) %>% 
      filter(cnt > 1) %>% ungroup(),
            by = "Question"
    ) %>% select(-lo_id, -`Learning Objective`)


x.questions.id.filterd

NA

We have the correct Questions. Now we need to add marks of answers against the questions.

X.pre <- x.questions.id %>% mutate(id = str_split(key, " ", simplify = TRUE)[,2]) %>% 
  
  inner_join(
    
    x.answers %>% mutate(id = str_split(key, " ", simplify = TRUE)[,3]), by = c("File", "SubjectID", "id")
    
    ) %>% 
  mutate(value.y = as.integer(value.y)) #%>% 
  #mutate(Q_UNIQUE_ID = as.integer(Q_UNIQUE_ID))

#write_csv(X.pre, "X_Pre.csv")
X.pre

unique(X.pre$Q_UNIQUE_ID)

  [1]   19  182  247  300  118   91  114   88   82    9  260  105   78   13  261   49   17  148  274  289   40  166   66  202  225  177  126  204  140  294  116  136
 [33]  186  223  149  229  122  282  137   64  292   67   33   30  272  505  974  481  980  478  989  494  497  461  523  466  404  377  442  355  530  515  475  431
 [65]  440  447  349  417  324  357  474  502  994  516  372  332  498  381  506  369  344  521  346  468  370  988  484  911  413  419  606  963  602  592  563  614
 [97]  550  607  593  612  558  943  947  559  661  935  912  567  659  557  932  926  647  629  554  578  572  641  619  648  920  962  965  555  817  732  814  870
[129]  810  866  837  761  844  665  816  849  786  842  727  879  822  860  710  901  694  760  888  883  874  767  780  739  765  715  788  856  755  750  823  713
[161]  666  664  667  722  663  691  668  909 1004  671  695  830  835  796  815  227  232   57   56  119  262  127  100  196  213   93   70  307   46  278  224   85
[193]   69   47  198   90  183   98  504  514  380  388  326  318  995  340  444  414  433  455  462  405  493  378  411  379  327  358  457  338  469  427  323  351
[225]  416  361  415  425  510  441  446  970  459  408  356  496  531  337  487  984  649  547  928  562  924  918  613  541  634  616  583  556  545  914  537  916
[257]  945  931  927  954  633  930  644  605  625  961  655  959  951  683  839  868  717  897  867  904  850  751  821  673  908  707  776  749  689  807  669  730
[289]  889  852  910  728  898  834  838  800  764  775  828  890  726  806  742  803  716  746  847  752  895  670  887  768  896  902  226   79  150  172   22  258
[321]  102  208  298  187  155  180   32   65  215   43  129  157  197  128  199  156  113   27  221  268   84  145    3  256   51  290  176  464  527  368  335  450
[353]  526  350  407  977  373  352  347  463  979  313  993  503  997  422  403  430  320  394  409  490  328  316  981  434  477  376  410  353  429  533  341  973
[385]  524  975  624  937  958  535  917  588  967  925  934  599  922  597  571  630  660  579  565  610  637  636  848  733  851  736  685  674  843  785  884  802
[417]  737  873  787  784  805  906  724  735  841  778  853  846  863  811  793  789  708  684  682  876  692  677  743  779  832  813  782  827  758   16  147  117
[449]  277  212  115  301   95  165  255  194   87   50   45  311  144  241  170   15   10  273    7   25  216  131  219  134  106  276   41  299  266  458  365  476
[481]  512  321  374  972  319  399  363  978  389  443  485  982  436  460  334  420  969  976  511  371  401  322  618  627  621  587  941  553  640  568  544  561
[513]  543  651  913  654  608  626  546  600  622  603  598  942  631  905  718  719  681  672  881  783  878  771  734  829  706  687  891  877  894  781  770  792
[545]  688  679  797  690  799  794  686  192  112  161  167   97  305  251  302   38   11  164   81  263   77  143   68  293   63  179  364  473  339  428  354  489
[577]  465  499  362  529  509  480  520  375  486  406  387  623  642  580  938  936  609  575  638  596  586  574  538  946  549  652  923  594  929  745  753  899
[609]  693  702  831  840  680  880  903  865  886  774  141  175  107  101   14  244  824  825  826  998  999 1000 1003  163   89   71  248  222  242  132  162  108
[641]  205  158  201  304   18   96  169  252  193  142  171  501  445  456  470  513  400  528  495  479  488  325  519  397  412  500  657  581  949  955  611  632
[673]  956  551  643  919  615  953  948  560  808  712  705  791  872  714  907  836  754  744  729  748  820  678  675   92  217  188  214  200    2  103   21  206
[705]  253  195  235   86   26  109  230  308  437  491  448  392  385  395  508  585  650  646  617  645  548  584  939  577  662  566  582  966  812  738  854  885
[737]  861  855  801  777  701  833  900  723  703   55  234  209   53  267  174  231  236  207  271  303  243   94  452  421  383  532  432  472  453  518  359  482
[769]  628  915  595  635  944  964  591  552  763  875  697  893  772  869  762  190  280  120   24  159  246   74  110   31  284  111  168   29  310  366  382  317
[801]  331  402  384  992  418  507  454  522  539  653  933  540  798 1005  759  700  795  731  725  747  871  864  699  809  178  154   39  285  281  160  238    1
[833]    4   28    5    8   42  525  314  492  333  423  343  604  542  845  766  859  819   23   76  138   73  135   37  426  439  983  348  564  601  576  590  921
[865]  773  704  709  804  279  211  259   83  104   44  391  534  656  573  862  769   80  233  264  185  296   12  367  396  390  987  658  892  790   72   99  287
[897]  151  275  306  449  336  950  756  250  152  451  882   36  257  424  639  698  740  283  146   60   61  398  345   75   62  297    6  985  996  393  940  124
[929]  270  309  952   52   48  218  240  125  467  210  471  858  181  121  191  696  139  249   20  288  220

X<- X.pre %>% select(-key.x, -key.y, -value.x, -id, -temp, -lo_id, -`Learning Objective`, -Question ) %>% 
  spread(key = "Q_UNIQUE_ID", value = "value.y")  
  

write_csv(X, "../data/FirstYearProject/X.csv")
X

Let’s run some test to verify X

X %>% select(-File, -SubjectID) %>% summarise_all(sum, na.rm = TRUE)

NA

X %>% gather(key = "QuestionID", value = "Score", -File, -SubjectID)

NA

Filter questions asked in Exam I

library(janitor)
X %>% filter(File == "Exam1Trial1") %>% remove_empty(.,which = "cols")

NA

Questions with good attempt count

question_attempted <- X %>% remove_empty(.,which = "cols") %>% 
  gather(key = "QuestionID", value = "Scores", -File, -SubjectID) %>% 
  group_by(File, QuestionID) %>%
  summarise(total_na = sum(is.na(Scores)), total = n(), total_attempted = total - total_na)

question_attempted <- question_attempted %>% filter(total_attempted >= 8)

question_attempted

#%>% filter(QuestionID == "103")

Filtering out questions with lesser attempts

X_filtered <- X %>% remove_empty(.,which = "cols") %>% 
  gather(key = "QuestionID", value = "Scores", -File, -SubjectID) %>% semi_join(question_attempted, by = c("File", "QuestionID")) %>% 
  spread(key = "QuestionID", value = "Scores")

X_filtered

Take away questions answered less that 5 times per exam

X %>% remove_empty(.,which = "cols") %>% write_csv("../data/FirstYearProject/X.csv")

X_filtered %>% remove_empty(.,which = "cols") %>% write_csv("../data/FirstYearProject/X_filtered.csv")

Write CSVs seperate for each trial to avoid having columns for those questions that were not asked in a trial. This will help to show the true picture of sparsity.

fn.clean <- function (df) {
  return(df %>% remove_empty(.,which = "cols"))
  
}


X.individual.list <- X %>% 
nest(-File, .key = "X_full") %>% 
  mutate(X = map(X_full, fn.clean), 
         Q_full = map(X_full, function(df) return (Q)))

X.individual.list

# A tibble: 8 x 4
  File        X_full              X                   Q_full             
  <chr>       <list>              <list>              <list>             
1 Exam1Trial1 <tibble [74 x 950]> <tibble [74 x 295]> <tibble [949 x 19]>
2 Exam1Trial2 <tibble [57 x 950]> <tibble [57 x 286]> <tibble [949 x 19]>
3 Exam2Trial1 <tibble [66 x 950]> <tibble [66 x 237]> <tibble [949 x 19]>
4 Exam2Trial2 <tibble [67 x 950]> <tibble [67 x 238]> <tibble [949 x 19]>
5 Exam3Trial1 <tibble [47 x 950]> <tibble [47 x 178]> <tibble [949 x 19]>
6 Exam3Trial2 <tibble [78 x 950]> <tibble [78 x 179]> <tibble [949 x 19]>
7 Exam4Trial1 <tibble [64 x 950]> <tibble [64 x 240]> <tibble [949 x 19]>
8 Exam4Trial2 <tibble [72 x 950]> <tibble [72 x 240]> <tibble [949 x 19]>

X %>% filter(File == "Exam1Trial1") %>% remove_empty(.,which = "cols")

NA

Merge with Q

Q

NA

fn.skills <- function (df) {
  
  df <- df %>% remove_empty(.,which = "cols") %>%
  gather(key = "Q_UNIQUE_ID", value = "Score", -SubjectID) %>%
  mutate(Q_UNIQUE_ID = as.integer(Q_UNIQUE_ID)) %>% distinct(Q_UNIQUE_ID) %>%
  
  inner_join(
    Q
    
  ) %>% remove_empty(.,which = "cols")  %>% mutate_all(function(x) ifelse(is.na(x), 0, x))
  
  return(df)
  
}


X.Q <- X.individual.list %>% 
  mutate(Q = map(X, fn.skills))

Joining, by = "Q_UNIQUE_ID"
Joining, by = "Q_UNIQUE_ID"
Joining, by = "Q_UNIQUE_ID"
Joining, by = "Q_UNIQUE_ID"
Joining, by = "Q_UNIQUE_ID"
Joining, by = "Q_UNIQUE_ID"
Joining, by = "Q_UNIQUE_ID"
Joining, by = "Q_UNIQUE_ID"

X.Q 

# A tibble: 8 x 5
  File        X_full              X                   Q_full              Q                  
  <chr>       <list>              <list>              <list>              <list>             
1 Exam1Trial1 <tibble [74 x 950]> <tibble [74 x 295]> <tibble [949 x 19]> <tibble [294 x 15]>
2 Exam1Trial2 <tibble [57 x 950]> <tibble [57 x 286]> <tibble [949 x 19]> <tibble [285 x 15]>
3 Exam2Trial1 <tibble [66 x 950]> <tibble [66 x 237]> <tibble [949 x 19]> <tibble [236 x 7]> 
4 Exam2Trial2 <tibble [67 x 950]> <tibble [67 x 238]> <tibble [949 x 19]> <tibble [237 x 7]> 
5 Exam3Trial1 <tibble [47 x 950]> <tibble [47 x 178]> <tibble [949 x 19]> <tibble [177 x 4]> 
6 Exam3Trial2 <tibble [78 x 950]> <tibble [78 x 179]> <tibble [949 x 19]> <tibble [178 x 4]> 
7 Exam4Trial1 <tibble [64 x 950]> <tibble [64 x 240]> <tibble [949 x 19]> <tibble [239 x 6]> 
8 Exam4Trial2 <tibble [72 x 950]> <tibble [72 x 240]> <tibble [949 x 19]> <tibble [239 x 6]> 

X %>% filter(File == "Exam2Trial2") %>% remove_empty(.,which = "cols") %>%
  gather(key = "Q_UNIQUE_ID", value = "Score", -File, -SubjectID) %>%
  mutate(Q_UNIQUE_ID = as.integer(Q_UNIQUE_ID)) %>% distinct(Q_UNIQUE_ID) %>%

  inner_join(
    Q, by = "Q_UNIQUE_ID"
    
  ) %>% remove_empty(.,which = "cols") %>% mutate_all(function(x) ifelse(is.na(x), 0, x)) %>% summarise_all(sum)

# A tibble: 1 x 7
  Q_UNIQUE_ID   `1`   `2`   `4`  `15`  `16`  `19`
        <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1      115028    97    70    67     1     1     1

X %>% filter(File == "Exam1Trial1")

NA

fn.write <- function(File, X_full, X, Q_full, Q) {

  
  print(X)
  X %>% write_csv(paste0("../data/FirstYearProject/",File,"_X.csv"))
  Q %>% write_csv(paste0("../data/FirstYearProject/",File,"_Q.csv"))
  
}

#walk2(X.Q$File, X.Q$data_clean, X.Q$data_Q_skills, fn.write)

pwalk(X.Q, fn.write)

NA
NA